home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 176-200 / disk_181 / amxlisp / src / xlimage.c < prev    next >
C/C++ Source or Header  |  1992-05-06  |  9KB  |  378 lines
  1. /* xlimage - xlisp memory image save/restore functions */
  2. /*    Copyright (c) 1985, by David Michael Betz
  3.     All Rights Reserved
  4.     Permission is granted for unrestricted non-commercial use    */
  5.  
  6. #include "xlisp.h"
  7.  
  8. #ifdef SAVERESTORE
  9.  
  10. /* external variables */
  11. extern LVAL obarray,xlenv,xlfenv,xldenv,s_gchook,s_gcflag;
  12. extern long nnodes,nfree,total;
  13. extern int anodes,nsegs,gccalls;
  14. extern struct segment *segs,*lastseg,*fixseg,*charseg;
  15. extern CONTEXT *xlcontext;
  16. extern LVAL fnodes;
  17.  
  18. /* local variables */
  19. static OFFTYPE off,foff,doff;
  20. static FILE *fp;
  21.  
  22. /* external procedures */
  23. extern SEGMENT *newsegment();
  24. extern FILE *osbopen();
  25. extern char *malloc();
  26.  
  27. /* forward declarations */
  28. OFFTYPE readptr();
  29. OFFTYPE cvoptr();
  30. LVAL cviptr();
  31.  
  32. /* xlisave - save the memory image */
  33. int xlisave(fname)
  34.   char *fname;
  35. {
  36.     char fullname[STRMAX+1];
  37.     unsigned char *cp;
  38.     SEGMENT *seg;
  39.     int n,i,max;
  40.     LVAL p;
  41.  
  42.     /* default the extension */
  43.     if (needsextension(fname)) {
  44.     strcpy(fullname,fname);
  45.     strcat(fullname,".wks");
  46.     fname = fullname;
  47.     }
  48.  
  49.     /* open the output file */
  50.     if ((fp = osbopen(fname,"w")) == NULL)
  51.     return (FALSE);
  52.  
  53.     /* first call the garbage collector to clean up memory */
  54.     gc();
  55.  
  56.     /* write out the pointer to the *obarray* symbol */
  57.     writeptr(cvoptr(obarray));
  58.  
  59.     /* setup the initial file offsets */
  60.     off = foff = (OFFTYPE)2;
  61.  
  62.     /* write out all nodes that are still in use */
  63.     for (seg = segs; seg != NULL; seg = seg->sg_next) {
  64.     p = &seg->sg_nodes[0];
  65.     for (n = seg->sg_size; --n >= 0; ++p, off += 2)
  66.         switch (ntype(p)) {
  67.         case FREE:
  68.         break;
  69.         case CONS:
  70.         case USTREAM:
  71.         setoffset();
  72.         osbputc(p->n_type,fp);
  73.         writeptr(cvoptr(car(p)));
  74.         writeptr(cvoptr(cdr(p)));
  75.         foff += 2;
  76.         break;
  77.         default:
  78.         setoffset();
  79.         writenode(p);
  80.         break;
  81.         }
  82.     }
  83.  
  84.     /* write the terminator */
  85.     osbputc(FREE,fp);
  86.     writeptr((OFFTYPE)0);
  87.  
  88.     /* write out data portion of SYMBOL/VECTOR/OBJECT/STRING/CLOSURE nodes */
  89.     for (seg = segs; seg != NULL; seg = seg->sg_next) {
  90.     p = &seg->sg_nodes[0];
  91.     for (n = seg->sg_size; --n >= 0; ++p)
  92.         switch (ntype(p)) {
  93.         case SYMBOL:
  94.         case OBJECT:
  95.         case VECTOR:
  96.         case CLOSURE:
  97.         max = getsize(p);
  98.         for (i = 0; i < max; ++i)
  99.             writeptr(cvoptr(getelement(p,i)));
  100.         break;
  101.         case STRING:
  102.         max = getslength(p);
  103.         for (cp = getstring(p); --max >= 0; )
  104.             osbputc(*cp++,fp);
  105.         break;
  106.         }
  107.     }
  108.  
  109.     /* close the output file */
  110.     osclose(fp);
  111.  
  112.     /* return successfully */
  113.     return (TRUE);
  114. }
  115.  
  116. /* xlirestore - restore a saved memory image */
  117. int xlirestore(fname)
  118.   char *fname;
  119. {
  120.     extern FUNDEF funtab[];
  121.     char fullname[STRMAX+1];
  122.     unsigned char *cp;
  123.     int n,i,max,type;
  124.     SEGMENT *seg;
  125.     LVAL p;
  126.  
  127.     /* default the extension */
  128.     if (needsextension(fname)) {
  129.     strcpy(fullname,fname);
  130.     strcat(fullname,".wks");
  131.     fname = fullname;
  132.     }
  133.  
  134.     /* open the file */
  135.     if ((fp = osbopen(fname,"r")) == NULL)
  136.     return (FALSE);
  137.  
  138.     /* free the old memory image */
  139.     freeimage();
  140.  
  141.     /* initialize */
  142.     off = (OFFTYPE)2;
  143.     total = nnodes = nfree = 0L;
  144.     fnodes = NIL;
  145.     segs = lastseg = NULL;
  146.     nsegs = gccalls = 0;
  147.     xlenv = xlfenv = xldenv = s_gchook = s_gcflag = NIL;
  148.     xlstack = xlstkbase + EDEPTH;
  149.     xlcontext = NULL;
  150.  
  151.     /* create the fixnum segment */
  152.     if ((fixseg = newsegment(SFIXSIZE)) == NULL)
  153.     xlfatal("insufficient memory - fixnum segment");
  154.  
  155.     /* create the character segment */
  156.     if ((charseg = newsegment(CHARSIZE)) == NULL)
  157.     xlfatal("insufficient memory - character segment");
  158.  
  159.     /* read the pointer to the *obarray* symbol */
  160.     obarray = cviptr(readptr());
  161.  
  162.     /* read each node */
  163.     while ((type = osbgetc(fp)) >= 0)
  164.     switch (type) {
  165.     case FREE:
  166.         if ((off = readptr()) == (OFFTYPE)0)
  167.         goto done;
  168.         break;
  169.     case CONS:
  170.     case USTREAM:
  171.         p = cviptr(off);
  172.         p->n_type = type;
  173.         p->n_flags = 0;
  174.         rplaca(p,cviptr(readptr()));
  175.         rplacd(p,cviptr(readptr()));
  176.         off += 2;
  177.         break;
  178.     default:
  179.         readnode(type,cviptr(off));
  180.         off += 2;
  181.         break;
  182.     }
  183. done:
  184.  
  185.     /* read the data portion of SYMBOL/VECTOR/OBJECT/STRING/CLOSURE nodes */
  186.     for (seg = segs; seg != NULL; seg = seg->sg_next) {
  187.     p = &seg->sg_nodes[0];
  188.     for (n = seg->sg_size; --n >= 0; ++p)
  189.         switch (ntype(p)) {
  190.         case SYMBOL:
  191.         case OBJECT:
  192.         case VECTOR:
  193.         case CLOSURE:
  194.         max = getsize(p);
  195.         if ((p->n_vdata = (LVAL *)malloc(max * sizeof(LVAL))) == NULL)
  196.             xlfatal("insufficient memory - vector");
  197.         total += (long)(max * sizeof(LVAL));
  198.         for (i = 0; i < max; ++i)
  199.             setelement(p,i,cviptr(readptr()));
  200.         break;
  201.         case STRING:
  202.         max = getslength(p);
  203.         if ((p->n_string = (unsigned char *)malloc(max)) == NULL)
  204.             xlfatal("insufficient memory - string");
  205.         total += (long)max;
  206.         for (cp = getstring(p); --max >= 0; )
  207.             *cp++ = osbgetc(fp);
  208.         break;
  209.         case STREAM:
  210.         setfile(p,NULL);
  211.         break;
  212.         case SUBR:
  213.         case FSUBR:
  214.         p->n_subr = funtab[getoffset(p)].fd_subr;
  215.         break;
  216.         }
  217.     }
  218.  
  219.     /* close the input file */
  220.     osclose(fp);
  221.  
  222.     /* collect to initialize the free space */
  223.     gc();
  224.  
  225.     /* lookup all of the symbols the interpreter uses */
  226.     xlsymbols();
  227.  
  228.     /* return successfully */
  229.     return (TRUE);
  230. }
  231.  
  232. /* freeimage - free the current memory image */
  233. LOCAL freeimage()
  234. {
  235.     SEGMENT *seg,*next;
  236.     FILE *fp;
  237.     LVAL p;
  238.     int n;
  239.  
  240.     /* free the data portion of SYMBOL/VECTOR/OBJECT/STRING nodes */
  241.     for (seg = segs; seg != NULL; seg = next) {
  242.     p = &seg->sg_nodes[0];
  243.     for (n = seg->sg_size; --n >= 0; ++p)
  244.         switch (ntype(p)) {
  245.         case SYMBOL:
  246.         case OBJECT:
  247.         case VECTOR:
  248.         case CLOSURE:
  249.         if (p->n_vsize)
  250.             free(p->n_vdata);
  251.         break;
  252.         case STRING:
  253.         if (getslength(p))
  254.             free(getstring(p));
  255.         break;
  256.         case STREAM:
  257.         if ((fp = getfile(p)) && (fp != stdin && fp != stdout))
  258.             osclose(getfile(p));
  259.         break;
  260.         }
  261.     next = seg->sg_next;
  262.     free(seg);
  263.     }
  264. }
  265.  
  266. /* setoffset - output a positioning command if nodes have been skipped */
  267. LOCAL setoffset()
  268. {
  269.     if (off != foff) {
  270.     osbputc(FREE,fp);
  271.     writeptr(off);
  272.     foff = off;
  273.     }
  274. }
  275.  
  276. /* writenode - write a node to a file */
  277. LOCAL writenode(node)
  278.   LVAL node;
  279. {
  280.     char *p = (char *)&node->n_info;
  281.     int n = sizeof(union ninfo);
  282.     osbputc(node->n_type,fp);
  283.     while (--n >= 0)
  284.     osbputc(*p++,fp);
  285.     foff += 2;
  286. }
  287.  
  288. /* writeptr - write a pointer to a file */
  289. LOCAL writeptr(off)
  290.   OFFTYPE off;
  291. {
  292.     char *p = (char *)&off;
  293.     int n = sizeof(OFFTYPE);
  294.     while (--n >= 0)
  295.     osbputc(*p++,fp);
  296. }
  297.  
  298. /* readnode - read a node */
  299. LOCAL readnode(type,node)
  300.   int type; LVAL node;
  301. {
  302.     char *p = (char *)&node->n_info;
  303.     int n = sizeof(union ninfo);
  304.     node->n_type = type;
  305.     node->n_flags = 0;
  306.     while (--n >= 0)
  307.     *p++ = osbgetc(fp);
  308. }
  309.  
  310. /* readptr - read a pointer */
  311. LOCAL OFFTYPE readptr()
  312. {
  313.     OFFTYPE off;
  314.     char *p = (char *)&off;
  315.     int n = sizeof(OFFTYPE);
  316.     while (--n >= 0)
  317.     *p++ = osbgetc(fp);
  318.     return (off);
  319. }
  320.  
  321. /* cviptr - convert a pointer on input */
  322. LOCAL LVAL cviptr(o)
  323.   OFFTYPE o;
  324. {
  325.     OFFTYPE off = (OFFTYPE)2;
  326.     SEGMENT *seg;
  327.  
  328.     /* check for nil */
  329.     if (o == (OFFTYPE)0)
  330.     return ((LVAL)o);
  331.  
  332.     /* compute a pointer for this offset */
  333.     for (seg = segs; seg != NULL; seg = seg->sg_next) {
  334.     if (o >= off && o < off + (OFFTYPE)(seg->sg_size << 1))
  335.         return (seg->sg_nodes + ((int)(o - off) >> 1));
  336.     off += (OFFTYPE)(seg->sg_size << 1);
  337.     }
  338.  
  339.     /* create new segments if necessary */
  340.     for (;;) {
  341.  
  342.     /* create the next segment */
  343.     if ((seg = newsegment(anodes)) == NULL)
  344.         xlfatal("insufficient memory - segment");
  345.  
  346.     /* check to see if the offset is in this segment */
  347.     if (o >= off && o < off + (OFFTYPE)(seg->sg_size << 1))
  348.         return (seg->sg_nodes + ((int)(o - off) >> 1));
  349.     off += (OFFTYPE)(seg->sg_size << 1);
  350.     }
  351. }
  352.  
  353. /* cvoptr - convert a pointer on output */
  354. LOCAL OFFTYPE cvoptr(p)
  355.   LVAL p;
  356. {
  357.     OFFTYPE off = (OFFTYPE)2;
  358.     SEGMENT *seg;
  359.  
  360.     /* check for nil and small fixnums */
  361.     if (p == NIL)
  362.     return ((OFFTYPE)p);
  363.  
  364.     /* compute an offset for this pointer */
  365.     for (seg = segs; seg != NULL; seg = seg->sg_next) {
  366.     if (CVPTR(p) >= CVPTR(&seg->sg_nodes[0]) &&
  367.         CVPTR(p) <  CVPTR(&seg->sg_nodes[0] + seg->sg_size))
  368.         return (off + (OFFTYPE)((p - seg->sg_nodes) << 1));
  369.     off += (OFFTYPE)(seg->sg_size << 1);
  370.     }
  371.  
  372.     /* pointer not within any segment */
  373.     xlerror("bad pointer found during image save",p);
  374. }
  375.  
  376. #endif
  377.  
  378.